home *** CD-ROM | disk | FTP | other *** search
/ Merciful 5 / Merciful - Disc 5.iso / software / p / pcqpascalv1.2d.lha / Examples2 / GetDate / GetDate.p < prev   
Encoding:
Text File  |  1997-05-06  |  2.9 KB  |  133 lines
  1. Program GetDate;
  2.  
  3. { GetDate v1.0 1995 by Andreas Tetzl }
  4. { Public Domain }
  5.  
  6. {$I "Include:DOS/DOS.i"}
  7. {$I "Include:DOS/RDArgs.i"}
  8. {$I "Include:DOS/DateTime.i"}
  9. {$I "Include:Utils/StringLib.i"}
  10.  
  11. const template = "Format/K,Help/S";
  12.  
  13.       version = "$VER: GetDate 1.0 (21.2.95)";
  14.  
  15. VAR DS : DateStampRec;
  16.     DT : DateTime;
  17.     rda : RDArgsPtr;
  18.     WeekDay, Date, Time, hours, mins, secs, day, month, year : String;
  19.     vec : Array[0..1] of Address;
  20.     i : Integer;
  21.     LFormat : String;
  22.  
  23. Procedure PrintFormat;
  24. VAR Str : String;
  25. Begin
  26.  Str:=AllocString(200);
  27.  For i:=0 to StrLen(LFormat)-1 do
  28.   begin
  29.    If LFormat[i]='%' then
  30.     Begin
  31.      Case ToUpper(LFormat[i+1]) of
  32.       'D' : StrCat(Str,Date);
  33.       'W' : StrCat(Str,WeekDay);
  34.       'T' : StrCat(Str,Time);
  35.       'H' : StrCat(Str,hours);
  36.       'M' : StrCat(Str,Mins);
  37.       'S' : StrCat(Str,Secs);
  38.       'A' : StrCat(Str,Day);
  39.       'O' : StrCat(Str,Month);
  40.       'Y' : StrCat(Str,Year);
  41.      end;
  42.      i:=i+1;
  43.     end
  44.    else
  45.     StrnCat(Str,adr(LFormat[i]),1);
  46.   end;
  47.  Writeln(Str);
  48.  FreeString(Str);
  49. end;
  50.  
  51. Procedure Help;
  52. Begin
  53.  Writeln("\nGetDate v1.0 1995 by Andreas Tetzl");
  54.  Writeln("Public Domain\n");
  55.  Writeln("Die Platzhalter für Format:\n");
  56.  Writeln(" %d : Datum");
  57.  Writeln(" %w : Wochentag");
  58.  Writeln(" %t : Uhrzeit mit Stunden, Minuten und Sekunden");
  59.  Writeln(" %h : Stunden");
  60.  Writeln(" %m : Minuten");
  61.  Writeln(" %s : Sekunden");
  62.  Writeln(" %a : Tag");
  63.  Writeln(" %o : Monat");
  64.  Writeln(" %y : Jahr\n");
  65.  Exit;
  66. end;
  67.  
  68. begin
  69.  For i:=0 to 1 do Vec[i]:=NIL;
  70.  
  71.  rda:=ReadArgs(Template,adr(vec),NIL);
  72.  If rda=NIL then
  73.   Begin
  74.    If PrintFault(IoErr,NIL) then;
  75.    Exit(10);
  76.   end;
  77.  
  78.  LFormat:=AllocString(100);
  79.  
  80.  If NOT StrEq(vec[0],"") then StrCpy(LFormat,vec[0]) else LFormat:=NIL;
  81.  If vec[1]<>NIL then Help;
  82.  
  83.  WeekDay:=AllocString(LEN_DATSTRING);
  84.  Date:=AllocString(LEN_DATSTRING);
  85.  Time:=AllocString(LEN_DATSTRING);
  86.  Hours:=AllocString(10);
  87.  Mins:=AllocString(10);
  88.  Secs:=AllocString(10);
  89.  Day:=AllocString(10);
  90.  Month:=AllocString(10);
  91.  Year:=AllocString(10);
  92.  
  93.  DateStamp(DS);
  94.  DT.dat_Stamp:=DS;
  95.  DT.dat_Format:=Format_DOS;
  96.  DT.dat_StrDay:=WeekDay;
  97.  DT.dat_StrDate:=Date;
  98.  DT.dat_StrTime:=Time;
  99.  If DateToStr(adr(DT)) then;
  100.  
  101.  StrnCpy(hours,Time,2);
  102.  StrnCpy(Mins,adr(Time[3]),2);
  103.  StrnCpy(Secs,adr(Time[6]),2);
  104.  StrnCpy(Day,Date,2);
  105.  StrnCpy(Month,adr(Date[3]),3);
  106.  StrnCpy(Year,adr(Date[7]),2);
  107.  
  108.  { In den deutschen Locale-Strings von OS3.0 scheint ein Fehler zu sein. }
  109.  { Am Datums-String ist hinten noch ein Leerzeichen, also "16-Feb-95 ".  }
  110.  { Hier wird geprüft, ob das letzte Zeichen ein Leerzeichen ist.         }
  111.  { Das Leerzeichen wird dann durch '\0' (Stringende) ersetzt.            }
  112.  If Date[StrLen(Date)-1]=' ' then Date[StrLen(Date)-1]:='\0';
  113.  
  114.  If LFormat=NIL then
  115.   Writeln(WeekDay," ",Date," ",Time)
  116.  else 
  117.   PrintFormat;
  118.  
  119.  FreeString(LFormat);
  120.  FreeString(WeekDay);
  121.  FreeString(date);
  122.  FreeString(Time);
  123.  FreeString(hours);
  124.  FreeString(mins);
  125.  FreeString(secs);
  126.  FreeString(Day);
  127.  FreeString(Month);
  128.  FreeString(Year);
  129. end.
  130.  
  131.  
  132.  
  133.